Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue46/Alfresco/AAGenExp.pas

Pascal/Delphi Source File | 1999-04-25 | 6.7 KB | 237 lines

{*********************************************************}
{* AAGenExp                                              *}
{* Copyright (c) Julian M Bucknall 1998-1999             *}
{* All rights reserved.                                  *}
{*********************************************************}
{* Simple RPN routines                                   *}
{*********************************************************}

{Note: this unit is released as freeware. In other words, you are free
       to use this unit in your own applications, however I retain all
       copyright to the code. JMB}

unit AAGenExp;

interface

type
  ThwExpression = string[7];
  ThwAlgebraicExpr = string[15];

type
  ThwProcessExpression = procedure(const aExpr : ThwExpression);


procedure GenerateExpressions(aProcessExpr : ThwProcessExpression);
  {-Generate RPN expressions, calling aProcessExpr for each one}

function EvaluateExpression(const aExpr   : ThwExpression;
                              var aAnswer : double) : boolean;
  {-Evaluate an RPN expression where operands are single digits}

function ConvertExpression(const aExpr : ThwExpression) : ThwAlgebraicExpr;
  {-Convert an RPN expression into an algebraic one, albeit with too
    many parentheses in many cases}


implementation

{===ConvertExpression================================================}
function ConvertExpression(const aExpr : ThwExpression) : ThwAlgebraicExpr;
var
  i : integer;
  SP : integer;
  Value1 : ThwAlgebraicExpr;
  Value2 : ThwAlgebraicExpr;
  Stack : array [0..9] of ThwAlgebraicExpr;
  Ch : char;
begin
  SP := 0;
  for i := 1 to length(aExpr) do begin
    Ch := aExpr[i];
    if ('0' <= Ch) and (Ch <= '9') then begin
      Stack[SP] := Ch;
      inc(SP);
    end
    else begin
      dec(SP); Value2 := Stack[SP];
      dec(SP); Value1 := Stack[SP];
      if (i < length(aExpr)) then
        Stack[SP] := '(' + Value1 + Ch + Value2 + ')'
      else
        Stack[SP] := Value1 + Ch + Value2;
      inc(SP);
    end;
  end;
  dec(SP); Result := Stack[SP];
end;
{====================================================================}


{===Helper routines for EvaluateExpression===========================}
function Power(X, Y : double; var Answer : double) : boolean;
begin
  Result := true;
  if (Y = 0.0) then
    Answer := 1.0
  else if (Y = 1.0) then
    Answer := X
  else if (X <= 0.0) then
    Result := false
  else
    Answer := exp(ln(X) * Y);
end;
{====================================================================}


{===EvaluateExpression===============================================}
function EvaluateExpression(const aExpr   : ThwExpression;
                              var aAnswer : double) : boolean;
var
  i : integer;
  SP : integer;
  Value1 : double;
  Value2 : double;
  Stack : array [0..9] of double;
  Ch : char;
begin
  Result := false;
  SP := 0;
  for i := 1 to length(aExpr) do begin
    Ch := aExpr[i];
    {push operands}
    if ('0' <= Ch) and (Ch <= '9') then begin
      Stack[SP] := ord(Ch) - ord('0');
      inc(SP);
    end
    {evaluate operators}
    else begin
      if (SP = 0) then Exit;
      dec(SP); Value2 := Stack[SP];
      if (SP = 0) then Exit;
      dec(SP); Value1 := Stack[SP];
      case Ch of
        '-' : Stack[SP] := Value1 - Value2;
        '+' : Stack[SP] := Value1 + Value2;
        '*' : Stack[SP] := Value1 * Value2;
        '/' : if (Value2 <> 0.0) then
                Stack[SP] := Value1 / Value2
              else
                Exit;
        '^' : if not Power(Value1, Value2, Stack[SP]) then
                Exit;
      end;
      inc(SP);
    end;
  end;
  if (SP <> 1) then Exit;
  dec(SP); aAnswer := Stack[SP];
  Result := true;
end;
{====================================================================}


{===Helper types, variables and routines for GenerateExpressions=====}
type
  String6 = string[6];
var
  Operators : string[5];
{--------}
procedure AddOperators(aProcess  : ThwProcessExpression;
                   var aExpr     : ThwExpression);
var
  i, i1, i2, i3 : integer;
  FirstBlank    : integer;
  SecondBlank   : integer;
begin
  {find the first and second blanks; the third is always at 7}
  FirstBlank := 0;
  SecondBlank := 0;
  for i := 3 to 6 do begin
    if (aExpr[i] = ' ') then
      if (FirstBlank = 0) then
        FirstBlank := i
      else begin
        SecondBlank := i;
        Break;
      end;
  end;
  {replace the blanks with every combination of the operators}
  for i1 := 1 to length(Operators) do begin
    aExpr[FirstBlank] := Operators[i1];
    for i2 := 1 to length(Operators) do begin
      aExpr[SecondBlank] := Operators[i2];
      for i3 := 1 to length(Operators) do begin
        aExpr[7] := Operators[i3];
        {process the completed RPN expression}
        aProcess(aExpr);
      end;
    end;
  end;
  {reset the blanks: the permutation/replacement logic requires it}
  aExpr[FirstBlank] := ' ';
  aExpr[SecondBlank] := ' ';
  aExpr[7] := ' ';
end;
{--------}
procedure PermuteOperands(aProcess : ThwProcessExpression;
                      var aExpr    : ThwExpression;
                          aInx     : integer);
var
  i, j : integer;
  Ch   : char;
begin
  if (aInx = 6) then begin
    AddOperators(aProcess, aExpr);
  end
  else
    for i := aInx to 6 do begin
      Ch := aExpr[i];
      aExpr[i] := aExpr[aInx];
      aExpr[aInx] := Ch;
      PermuteOperands(aProcess, aExpr, succ(aInx));
      aExpr[aInx] := aExpr[i];
      aExpr[i] := Ch;
    end;
end;
{====================================================================}


{===GenerateExpressions==============================================}
procedure GenerateExpressions(aProcessExpr : ThwProcessExpression);
var
  Expr     : ThwExpression;
  i1, i2   : integer;
  Ch1, Ch2 : char;
  Operands : String6;
begin
  {preset the expression string to the operands plus three spaces}
  Expr := '2357   ';
  Operators := '+-*/';
  {generate the first token: an operand}
  for i1 := 1 to 4 do begin
    {swap characters 1 and i1}
    Ch1 := Expr[i1];
    Expr[i1] := Expr[1];
    Expr[1] := Ch1;
    {generate the second token: an operand}
    for i2 := 2 to 4 do begin
      {swap characters 2 and i2}
      Ch2 := Expr[i2];
      Expr[i2] := Expr[2];
      Expr[2] := Ch2;
      {permute tokens 3 thru 6}
      PermuteOperands(aProcessExpr, Expr, 3);
      {swap characters 2 and i2 back again}
      Expr[2] := Expr[i2];
      Expr[i2] := Ch2;
    end;
    {swap characters 1 and i1 back again}
    Expr[1] := Expr[i1];
    Expr[i1] := Ch1;
  end;
end;
{====================================================================}

end.